home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / perl5.002 / writemain < prev    next >
Encoding:
Text File  |  1996-05-16  |  2.1 KB  |  95 lines  |  [TEXT/EDIT]
  1. #!perl
  2. # This script takes the plain miniperlmain.c and writes out perlmain.c
  3. # which includes all the extensions.
  4. # The command line arguments name extensions to be used.
  5. #  E.g.:  miniperl writemain SDBM_File POSIX > perlmain.c
  6. #
  7.  
  8. if ($ARGV[0] eq "-runperl") {
  9.     $runperl = shift @ARGV;
  10. }
  11.  
  12. foreach (@ARGV) {
  13.     s/\.o$//; s/\.o\.PPC$//; s/\.o\.68K$//; 
  14.     s/ext:(.*):[^:]*/$1/ && next;
  15.     s/.*:(.*)/$1/;
  16. }
  17.  
  18. open(MAIN, "miniperlmain.c") || die "Couldn't open miniperlmain.c: $!";
  19.  
  20. while (<MAIN>) {
  21.     s/perl_destruct/perl_destruct_level = 2;\n\n    perl_destruct/ if $runperl;
  22.     s/^main\(/run_perl\(/ if $runperl;
  23.     last if /Do not delete this line--writemain depends on it/;
  24.     print;
  25. }
  26.  
  27. print <<EOP;
  28.  
  29. static void
  30. xs_init()
  31. {
  32.     dXSUB_SYS;
  33. EOP
  34.  
  35. if ($#ARGV > -1) {
  36.     print "    char *file = __FILE__;\n";
  37.     $ai = "";
  38.     
  39.     foreach $ext (@ARGV) {
  40.     ($mname = $ext) =~ s!/!::!g;
  41.     ($cname = $mname) =~ s!:!_!g;
  42.         
  43.     print "    {   extern void boot_${cname} _((CV* cv));\n";
  44.         
  45.     if ($ext eq "DynaLoader") {
  46.         # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
  47.         # boot_DynaLoader is called directly in DynaLoader.pm
  48.         print "        newXS(\"${mname}::boot_${ext}\", boot_${cname}, file);\n";
  49.     } else {
  50.         print "        newXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
  51.     }
  52.         
  53.     if (opendir(AUTOINIT, ":ext:$ext:")) {
  54.         while ($auto = readdir(AUTOINIT)) {
  55.         next unless ($auto =~ /^AutoInit\./i);
  56.         open(AI, ":ext:$ext:$auto");
  57.         if ($auto =~ /\.c$/) {
  58.             print "    /* autoinit code from $aifile follows: */\n";
  59.             print "    {\n";
  60.             while (<AI>) {
  61.             print;
  62.             }
  63.             print "    }\n";
  64.         } elsif ($auto =~ /\.pl$/) {
  65.             while (<AI>) {
  66.             chop;
  67.             $ai .= $_ . " ";
  68.             }
  69.         }
  70.         }
  71.     }
  72.     print "    }\n";
  73.     }
  74.     if ($ai ne "") {
  75.     print <<END_AUTOBOOT;
  76.     if (!preambleav)
  77.     preambleav = newAV();
  78.     av_push(preambleav, newSVpv("BEGIN { $ai }",0));
  79. END_AUTOBOOT
  80.     }
  81.     print "    av_push(GvAVn(incgv), newSVpv(\"Dev:Pseudo:\", 0));\n" if ($runperl);
  82. }
  83. print "}\n";
  84.  
  85. if ($runperl) {
  86.     print <<END_EXIT;
  87.  
  88. #undef exit
  89.  
  90. void (exit)(int status)
  91. {
  92.     my_exit(status);
  93. }
  94. END_EXIT
  95. }